ETO Development Tools 1/ETO Development Tools 1.iso/Tools - Objects/MacApp/MacApp 2.0 CD Release/MacApp 2.0 (Many Libraries)/Examples/Cards/UCards.inc1.p

Text File | 1990-03-27 | 51.2 KB | 1,816 lines | [TEXT/MPS ]

{$P}
{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n+]}
{ UCards.inc1.p}
{ Copyright © 1986-1990 by Apple Computer, Inc.  All rights reserved. }

CONST
    kStdBufSize         = 1024;
    kAboutDoc            = 1201;                            { About box showing document info }
    kIDAppBuzz            = 1000;                         { Our buzz string resource }
    bzNoCardsThere        = 1;                            { No cards to be shown }
    kStaggerAmount        = 16;                            { How much to stagger windows by }
    kInitialCacheSize    = 7;                            { How many cards will we keep in the cache }
    kCacheGrowthRate    = 2;                            { If we need to grow the cache, how large
                                                          should we make it }
    kReserveSpace        = 32000;                        { How much space must be reserved per
                                                          document }

VAR
    gStaggerCount:        INTEGER;                        { Used by SimpleStagger }
    gCache:             TCardCache;                     { The global cache for the application's
                                                          cards }

{--------------------------------------------------------------------------------------------------}
{$S AWriteFile}

PROCEDURE CopyFilePiece(fromRefNum: INTEGER; toRefNum: INTEGER; amount: LongInt; bufSize: INTEGER);

    VAR
        amtLeft:            LongInt;
        count:                LongInt;
        bufPtr:             Ptr;
        fi:                 FailInfo;

{--------------------------------------------------------------------------------------------------}

    PROCEDURE HdlCopyErr(error: OSErr; message: LongInt);

        BEGIN
        DisposPtr(bufPtr);
        END;

    BEGIN
    bufPtr := NewPtr(bufSize);
    FailNil(bufPtr);
    amtLeft := amount;

    CatchFailures(fi, HdlCopyErr);
    WHILE amtLeft > 0 DO
        BEGIN
        count := Min(amtLeft, bufSize);
        FailOSErr(FSRead(fromRefNum, count, bufPtr));
        FailOSErr(FSWrite(toRefNum, count, bufPtr));
        amtLeft := amtLeft - bufSize;
        END;
    DisposPtr(bufPtr);
    Success(fi);
    END;

{--------------------------------------------------------------------------------------------------}
{$S AInit}

PROCEDURE TCardsApplication.ICardsApplication;

    BEGIN
    { Do Misc initialization here... }
    gStaggerCount := 0;
    IApplication(kFileType);

    New(gCache);
    FailNil(gCache);
    gCache.ICardCache(kInitialCacheSize, kCacheGrowthRate);

    IF qDebug THEN
        gCache.SetELTType('TCard');

    { Suppress dead-stripping for the following classes }
    IF gDeadStripSuppression THEN
        BEGIN
        IF Member(TObject(NIL), TCardView) THEN ;
        IF Member(TObject(NIL), TEmptyView) THEN ;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AOpen}

FUNCTION TCardsApplication.DoMakeDocument(itsCmdNumber: CmdNumber): TDocument; OVERRIDE;

    VAR
        aCardDocument:        TCardDocument;

    BEGIN
    New(aCardDocument);                                 { allocate the document }
    FailNil(aCardDocument);                             { Make sure we could }

    aCardDocument.ICardDocument;                        { Initialize it }
    DoMakeDocument := aCardDocument;                    { return the document object as the function
                                                          value }
    END;

{--------------------------------------------------------------------------------------------------}
{$S AAboutApp}

PROCEDURE TCardsApplication.DoShowAboutApp; OVERRIDE;
 { We override this so that the About… dialog will show information about
   the currently open card document. }

    VAR
        curWindow:            TWindow;
        curCardDocument:    TCardDocument;
        paramZero:            string[63];
        paramOne:            Str255;
        paramTwo:            string[2];
        paramThree:            Str255;
        dataBytes:            LongInt;
        rsrcBytes:            LongInt;
        theAlert:            INTEGER;

    BEGIN
    curCardDocument := NIL;                                { Find the current document }
    curWindow := GetFrontWindow;
    IF curWindow <> NIL THEN                            { Make sure it's a Cards document }
        IF Member(TObject(curWindow.fDocument), TCardDocument) THEN
            curCardDocument := TCardDocument(curWindow.fDocument);

    IF curCardDocument = NIL THEN                        { there is no current document }
        INHERITED DoShowAboutApp                        { …so show a generic About Box }
    ELSE
        BEGIN
        theAlert := kAboutDoc;
        paramZero := curCardDocument.fTitle^^;
        NumToString(curCardDocument.fCards.GetSize, paramOne);
        IF paramOne = '1' THEN
            paramTwo := ''
        ELSE
            paramTwo := 's';
        dataBytes := 0;
        curCardDocument.DoNeedDiskSpace(dataBytes, rsrcBytes);
        NumToString(dataBytes, paramThree);
        ParamText(paramZero, paramOne, paramTwo, paramThree);
        StdAlert(theAlert);                                    { display the about box }
        END;

    END;

{--------------------------------------------------------------------------------------------------}
{$S AOpen}

PROCEDURE TCardDocument.ICardDocument;

    BEGIN
    { Set fCards and fCache to NIL in case initialization fails before they can be allocated. }
    fCards := NIL;
    fCache := NIL;

 { This is how we tell MacApp we're disk-based:  by indicating that we want
   the data fork of the document left open. }
    IDocument(kFileType, kSignature, kUsesDataFork, NOT kUsesRsrcFork, kDataOpen, NOT kRsrcOpen);

    fCardView := NIL;
    fEmptyView := NIL;
    fWorkRefNum := - 1;                                 { No work file, initially }
    fWorkFileName := '';
    fWorkVRefNum := - 1;
    fCards := NewList;
    IF qDebug THEN
        fCards.SetELTType('TCard');
    FailMemError;
    fCache := gCache;                                    { What is the cache object for the
                                                         application }

    CreateWorkFile;                                     { Now try creating a work file }
    END;

{--------------------------------------------------------------------------------------------------}
{$S AClose}

PROCEDURE TCardDocument.Free; OVERRIDE;

    BEGIN
    FreeData;
    fCache.FreeDocCards(SELF);
    FreeIfObject(fCards);
    { All views are now freed automatically }
    PurgeWorkFile;
    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

FUNCTION TCardDocument.AddCard: INTEGER;

    VAR
        aCard:                TCard;
        fi:                 FailInfo;

{--------------------------------------------------------------------------------------------------}

    PROCEDURE HdlInsertFailed(error: OSErr; message: LongInt);

        BEGIN
        FreeIfObject(aCard);
        END;

    BEGIN
    New(aCard);
    FailNil(aCard);
    aCard.ICard(0, SELF);
    CatchFailures(fi, HdlInsertFailed);
    fCards.InsertLast(aCard);
    Success(fi);
    aCard.fLocked := TRUE;                                { Don't write out }
    aCard.fDirty := TRUE;                                { Card is dirty (actually, non-existent) }
    AddCard := fCards.GetSize;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCardDocument.CacheCard(aCard: TCard);
{ Force the specified card to be in the cache, so that its data handle is valid }

    BEGIN
    fCache.CacheCard(SELF, aCard);
    END;

{--------------------------------------------------------------------------------------------------}
{$S AReadFile}

PROCEDURE TCardDocument.ConstructCardIndex(aRefNum: INTEGER);
 { Build the in-memory index to the open card document.  Notice that the
  card file architecture used here is rather inefficient, since the
  lengths of the cards are scattered all over the disk.  In a real
  application, you would almost certainly collect them in one place so
  they could be read in a with a contiguous read.  We've only done it
  this way so that we can use the same routines to write a card to the
  work file and to the document file (i.e., laziness).    The main reason
  the Resource Manager on the 64K ROM was so slow is that it used a
  data structure similar to this. }

    VAR
        nextFileLoc:        LongInt;                    { Next place in file }
        cardChars:            INTEGER;                    { Size of a card }
        nChars:             LongInt;                    { Count for I/O }
        i:                    INTEGER;                    { Index for card being read }
        aCard:                TCard;                        { A handy card }
        fi:                 FailInfo;

{--------------------------------------------------------------------------------------------------}

    PROCEDURE HdlIndexFailure(error: OSErr; message: LongInt);

        BEGIN
        FreeIfObject(aCard);
        FreeData;                                        { Represent as an empty document }
        END;

    BEGIN
    aCard := NIL;
    CatchFailures(fi, HdlIndexFailure);
    FailOSErr(GetFPos(aRefNum, nextFileLoc));            { Get current position }

    FOR i := 1 TO fCardDocData.theCardCount DO
        BEGIN
        { Seek to the location of the next card's length, then read its length }
        FailOSErr(SetFPos(aRefNum, fsFromStart, nextFileLoc));

        nChars := SIZEOF(cardChars);                    { Read the size }
        FailOSErr(FSRead(aRefNum, nChars, @cardChars));

  { Create a new card object to represent the card, and insert it in our
   index. Also calculate the location of the next card's size. }
        New(aCard);
        FailNil(aCard);
        aCard.ICard(nextFileLoc, SELF);
        aCard.fDataSize := cardChars;
        fCards.InsertLast(aCard);
        aCard := NIL;

        nextFileLoc := nextFileLoc + SIZEOF(INTEGER) + cardChars;
        END;
    Success(fi);
    END;

{--------------------------------------------------------------------------------------------------}
{$S AOpen}

PROCEDURE TCardDocument.CreateWorkFile;

    VAR
        aFileName:            Str255;
        aVRefNum:            INTEGER;
        workRefNum:         INTEGER;

    BEGIN
 { Use TDocument.GetTempName to get a unique name to avoid Switcher/shared
   disk collisions. Put the file on the default volume (i.e., the one
   the application was run from.  In the highly unlikely event we do get
   a name conflict, don't trash whatever file we do conflict with. }

    GetTempName(aFileName);
    aVRefNum := gConfiguration.sysVRefNum;
    FailOSErr(Create(aFileName, aVRefNum, kSignature, kWorkType));
    FailOSErr(FSOpen(aFileName, aVRefNum, workRefNum));

    fWorkVRefNum := aVRefNum;
    fWorkFileName := aFileName;
    fWorkRefNum := workRefNum;

    fWorkNext := 0;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCardDocument.DeleteCard(aCard: TCard);

    BEGIN
    fCards.Delete(aCard);
    fCache.Delete(aCard);
    END;

{--------------------------------------------------------------------------------------------------}
{$S AOpen}

PROCEDURE TCardDocument.DoInitialState; OVERRIDE;

    BEGIN
    WITH fCardDocData DO
        BEGIN
        theShownCard := - 1;
        theCardCount := 0;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AOpen}

PROCEDURE TCardDocument.DoMakeViews(forPrinting: BOOLEAN); OVERRIDE;

    VAR
        aCardView:            TCardView;
        aStdHandler:        TStdPrintHandler;
        aWindow:            TWindow;

    BEGIN
 { This document has two view types: one, a descendant of TTEView, shows
   cards; the other displays a simple message when there are no cards to
   show. We create the card view first. If we're not finder printing,
   then we create the window with the empty view already installed.}

    aCardView := TCardView(DoCreateViews(SELF, NIL, kCardViewRsrcID, gZeroVPt));
    FailNil(aCardView);                                 { Exit and tidy up if allocation fails }
    fCardView := aCardView;

    New(aStdHandler);                                    { Make the card view printable }
    FailNil(aStdHandler);
    aStdHandler.IStdPrintHandler(SELF, fCardView, NOT kSquareDots, kFixedSize, kFixedSize);

    IF NOT forPrinting THEN
        BEGIN
        aWindow := NewTemplateWindow(kWindowRsrcID, SELF);
        fEmptyView := TEmptyView(aWindow.FindSubView('EMPT'));

        New(aStdHandler);                                { Make the empty view printable }
        FailNil(aStdHandler);
        aStdHandler.IStdPrintHandler(SELF, fEmptyView, NOT kSquareDots, kFixedSize, kFixedSize);

  { Stick the appropriate view in the window, depending on whether there are
    any cards or not. }
        IF fCardDocData.theCardCount > 0 THEN
            BEGIN
            SwapViews(fEmptyView, fCardView);
            fCardView.InstallCard(fCardDocData.theShownCard); { Restore the proper card }
            END
        ELSE
            fCurrView := fEmptyView;
        END

    ELSE                                                { Finder print only--don't need a window or
                                                         an empty view }
    IF fCardDocData.theCardCount <= 0 THEN
        fDocPrintHandler := aStdHandler;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

FUNCTION TCardDocument.DoMenuCommand(aCmdNumber: CmdNumber): TCommand; OVERRIDE;

    VAR
        aNewCardCommand:    TNewCardCommand;            { Command to add a card }

    BEGIN
    { The only command the document handles is to create a new card. }
    IF aCmdNumber = cNewCard THEN
        BEGIN
        New(aNewCardCommand);
        FailNil(aNewCardCommand);
        aNewCardCommand.INewCardCommand(aCmdNumber, SELF);
        DoMenuCommand := aNewCardCommand;
        END
    ELSE
        DoMenuCommand := INHERITED DoMenuCommand(aCmdNumber);
    END;

{--------------------------------------------------------------------------------------------------}
{$S AWriteFile}

PROCEDURE TCardDocument.DoNeedDiskSpace(VAR dataForkBytes, rsrcForkBytes: LongInt); OVERRIDE;

    VAR
        aSize:                LongInt;

{--------------------------------------------------------------------------------------------------}

    PROCEDURE AccumulateSize(obj: TObject);

        BEGIN
        IF NOT TCard(obj).fDeleted THEN
            IF TCard(obj) = fCardView.fCurrCard THEN
                aSize := aSize + GetHandleSize(fCardView.fText) + SIZEOF(INTEGER)
            ELSE
                aSize := aSize + TCard(obj).fDataSize + SIZEOF(INTEGER);
        END;

    BEGIN
    INHERITED DoNeedDiskSpace(dataForkBytes, rsrcForkBytes);

    aSize := 0;
    fCards.Each(AccumulateSize);
    dataForkBytes := dataForkBytes + SIZEOF(CardDocData) + aSize;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AReadFile}

PROCEDURE TCardDocument.DoRead(aRefNum: INTEGER; rsrcExists, forPrinting: BOOLEAN); OVERRIDE;

    VAR
        theCardDocData:     CardDocData;                { Temporary buffer }
        nChars:             LongInt;                    { Count for I/O }
        fi:                 FailInfo;

{--------------------------------------------------------------------------------------------------}

    PROCEDURE HdlReadFailed(error: OSErr; message: LongInt);

        BEGIN
        DoInitialState;                                 { Get into self-consistent state for Free }
        END;

    BEGIN
    INHERITED DoRead(aRefNum, rsrcExists, forPrinting);
    nChars := SIZEOF(CardDocData);                        { Read the size }
    FailOSErr(FSRead(aRefNum, nChars, @theCardDocData));
    fCardDocData := theCardDocData;
    { When called on to read the document, just build the in-memory index. }
    ConstructCardIndex(aRefNum);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCardDocument.DoSetupMenus; OVERRIDE;

    BEGIN
    INHERITED DoSetupMenus;
    Enable(cNewCard, TRUE);
    END;

{--------------------------------------------------------------------------------------------------}
{$S AWriteFile}

PROCEDURE TCardDocument.DoWrite(aRefNum: INTEGER; makingCopy: BOOLEAN); OVERRIDE;
 { This procedure must merge the contents of the work file and the saved
  document file (if any) into a new, clean copy of the document. }

    VAR
        chunkSize:            LongInt;                    { Size of contiguous chunk we can copy }
        theCardDocData:     CardDocData;                { File header information }
        nextFileLoc:        LongInt;                    { Next expected file position }
        nextOutLoc:         LongInt;                    { Next output location }

{--------------------------------------------------------------------------------------------------}

    PROCEDURE CopyFlush;
    { If there are any cards left uncopied, copy them now. }

        BEGIN
        IF chunkSize > 0 THEN
            BEGIN
            CopyFilePiece(fDataRefNum, aRefNum, chunkSize, kStdBufSize);
            chunkSize := 0;
            END;
        END;

{--------------------------------------------------------------------------------------------------}

    PROCEDURE CopyToFile(obj: TObject);

    { Either write a card to the output file, or save it up in a batch for
      copying en masse.  This scheme, although not terribly sophisticated,
      is an example of how to special-case code to improve performance.
      The idea is to avoid reading and writing the cards one at a time when
      a contiguous batch of them from the original file have never been
      changed. }

        VAR
            aCard:                TCard;

        BEGIN
        aCard := TCard(obj);

        WITH aCard DO
            BEGIN
            IF fChanged OR fDirty THEN
    { The card does not match what's in the file, and so forces an
      end to the previous chunk.  Write out what we have now,
      and write the card out individually. }
                BEGIN
                CopyFlush;
                CacheCard(aCard);
                WriteCopy(aRefNum);
                END
            ELSE
                BEGIN
                IF nextFileLoc <> fLocInFile THEN
                { End of previous contiguous chunk }
                    CopyFlush;
                IF chunkSize <= 0 THEN                    { We're starting a new chunk }
                    BEGIN
                    FailOSErr(SetFPos(fDataRefNum, fsFromStart, fLocInFile));
                    nextFileLoc := fLocInFile;
                    END;
                chunkSize := chunkSize + SIZEOF(INTEGER) + fDataSize;
                nextFileLoc := nextFileLoc + SIZEOF(INTEGER) + fDataSize;
                END;
            END;
        END;

    BEGIN
    INHERITED DoWrite(aRefNum, makingCopy);
    chunkSize := SIZEOF(CardDocData);                    { Get the size }
    theCardDocData := fCardDocData;
    FailOSErr(FSWrite(aRefNum, chunkSize, @theCardDocData));
    FailOSErr(GetFPos(aRefNum, nextOutLoc));
    fFirstWritten := nextOutLoc;
    nextFileLoc := 0;
    chunkSize := 0;
    fCards.Each(CopyToFile);
    CopyFlush;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AClose}

PROCEDURE TCardDocument.EmptyWorkFile;
{ Truncate the work file to make it empty }

    VAR
        err:                OSErr;

    BEGIN
    IF fWorkVRefNum <= 0 THEN
        BEGIN
        { If this doesn't work, don't blow user off }
        err := SetEOF(fWorkRefNum, 0);

        fWorkNext := 0;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TCardDocument.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
                                                   fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TCardDocument', NIL, bClass);
    DoToField('fCardView', @fCardView, bObject);
    DoToField('fEmptyView', @fEmptyView, bObject);
    DoToField('fCurrView', @fCurrView, bObject);
    DoToField('fCards', @fCards, bObject);
    DoToField('fCache', @fCache, bObject);
    DoToField('fCardDocData', NIL, bTitle);
    DoToField('  theCardCount', @fCardDocData.theCardCount, bInteger);
    DoToField('  theShownCard', @fCardDocData.theShownCard, bInteger);
    DoToField('fReopening', @fReopening, bBoolean);
    DoToField('fWorkFileName', @fWorkFileName, bString);
    DoToField('fWorkVRefNum', @fWorkVRefNum, bInteger);
    DoToField('fWorkRefNum', @fWorkRefNum, bInteger);
    DoToField('fWorkNext', @fWorkNext, bLongInt);
    DoToField('fFirstWritten', @fFirstWritten, bLongInt);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

FUNCTION TCardDocument.FirstCard: INTEGER;
 { Figure out the first card in the document, filtering out any possibly
   deleted card. }

    VAR
        maybeCard:            INTEGER;                    { Might be this one }

    BEGIN
    maybeCard := 1;
    IF TCard(fCards.At(maybeCard)).fDeleted THEN
        maybeCard := NextCard(maybeCard);
    FirstCard := maybeCard;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AClose}

PROCEDURE TCardDocument.FreeData;

    BEGIN
    PurgeCards;
    EmptyWorkFile;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

FUNCTION TCardDocument.LastCard: INTEGER;
 { Figure out the last card in the document, filtering out any possibly
   deleted card. }

    VAR
        maybeCard:            INTEGER;                    { Might be this one }

    BEGIN
    maybeCard := fCards.GetSize;
    IF TCard(fCards.At(maybeCard)).fDeleted THEN
        maybeCard := PrevCard(maybeCard);
    LastCard := maybeCard;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

FUNCTION TCardDocument.NextCard(theCard: INTEGER): INTEGER;
 { Figure out the next card in the document, filtering out any possibly
   deleted card. }

    VAR
        maybeCard:            INTEGER;                    { Might be this one }

    BEGIN
    maybeCard := theCard;
    REPEAT
        maybeCard := maybeCard + 1;
    UNTIL (maybeCard > fCards.GetSize) | (NOT TCard(fCards.At(maybeCard)).fDeleted);
    IF maybeCard > fCards.GetSize THEN
        maybeCard := - 1;
    NextCard := maybeCard;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

FUNCTION TCardDocument.PrevCard(theCard: INTEGER): INTEGER;
 { Figure out the previous card in the document, filtering out any possibly
   deleted card. }

    VAR
        maybeCard:            INTEGER;                    { Might be this one }

    BEGIN
    maybeCard := theCard;
    REPEAT
        maybeCard := maybeCard - 1;
    UNTIL (maybeCard <= 0) | (NOT TCard(fCards.At(maybeCard)).fDeleted);
    IF maybeCard <= 0 THEN
        maybeCard := - 1;
    PrevCard := maybeCard;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AClose}

PROCEDURE TCardDocument.PurgeCards;

    BEGIN
    IF fCache <> NIL THEN
        fCache.FreeDocCards(SELF);

    IF fCards <> NIL THEN
        BEGIN
        fCards.Each(FreeIfObject);
        fCards.DeleteAll;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AClose}

PROCEDURE TCardDocument.PurgeWorkFile;
{ Get rid of our working file }

    BEGIN
    IF fWorkVRefNum <= 0 THEN
        BEGIN
        FailOSErr(FSClose(fWorkRefNum));
        {$Push} {$H-}
        FailOSErr(FSDelete(fWorkFileName, fWorkVRefNum));
        {$Pop}
        END;
    fWorkVRefNum := 1;
    fWorkFileName := '';
    fWorkRefNum := - 1;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCardDocument.ReadCardFromDisk(aCard: TCard);
 { Read a card from disk.  In the special case where we are being asked
   to read a dirty card, it must be a newly created card which is not
   yet in the cache, nor does it have a data handle.  Just create an
   empty one for it. }

    VAR
        aRefNum:            INTEGER;
        aHandle:            Handle;

    BEGIN
    IF aCard.fDirty THEN                                { Must be a new card, or we wouldn't be
                                                         reading it }
        BEGIN
        aHandle := NewPermHandle(0);
        aCard.fData := aHandle;
        FailNil(aHandle);
        END
    ELSE
        BEGIN
        IF aCard.fChanged THEN
            aRefNum := fWorkRefNum
        ELSE
            aRefNum := fDataRefNum;
        aCard.ReadFrom(aRefNum);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AClose}

PROCEDURE TCardDocument.SavedOn(VAR fileName: Str255; volRefNum: INTEGER); OVERRIDE;
 { Make changes to our in-memory data structures to reflect the fact that
   we have successfully saved a clean copy of the document. These include
   updating all the card's addresses and wiping the work file clean. }

    VAR
        nextOutLoc:         LongInt;                    { Next position for a card }

{--------------------------------------------------------------------------------------------------}

    PROCEDURE LocateSelf(obj: TObject);

        VAR
            aCard:                TCard;

        BEGIN
        aCard := TCard(obj);
        aCard.NewHome(nextOutLoc);
        nextOutLoc := nextOutLoc + SIZEOF(INTEGER) + aCard.fDataSize;
        END;

    BEGIN
    INHERITED SavedOn(fileName, volRefNum);

 { Note that if this were an expensive operation, it might be put in DoWrite.
   The DoWrite parameter makingCopy is intended to allow you to perform
   updates such as this while you are in the process of writing the file
   out. If FALSE, it indicates that you are writing the document itself
   rather than a copy and thus you might want to update your in-memory
   structures on the fly rather than after the fact, as we are doing here.
   If you decide to do this, note that if the save fails for some reason
   your in-memory structures will be left in an inconsistent state. }

    nextOutLoc := fFirstWritten;                        { First card written during last DoWrite }
    fCards.Each(LocateSelf);
    EmptyWorkFile;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AReadFile}

PROCEDURE TCardDocument.ShowReverted; OVERRIDE;
 { We must override this so that if the appropriate view to show changes
   based on the contents of the reverted document, we install it properly. }

    BEGIN
    fCardView.fCurrNumber := - 1;
    fCardView.fCurrCard := NIL;
    INHERITED ShowReverted;
    IF fCardDocData.theCardCount = 0 THEN
        BEGIN
        IF fCurrView <> fEmptyView THEN
            SwapViews(fCurrView, fEmptyView);
        END
    ELSE
        BEGIN
        IF fCurrView <> fCardView THEN
            SwapViews(fCurrView, fCardView);
        fCardView.InstallCard(fCardDocData.theShownCard);
        gApplication.SetTarget(fCardView);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCardDocument.SwapViews(fromView, toView: TView);

    VAR
        itsScroller:        TScroller;
        itsSize:            VPoint;

    BEGIN
    itsScroller := fromView.GetScroller(FALSE);         { Get its scroller. }

    itsScroller.RemoveSubView(fromView);
    itsScroller.AddSubView(toView);
    itsSize := toView.fSize;
    itsScroller.SetScrollLimits(itsSize,                { Make sure scroller gets adjusted. }
                                kVisible);
    itsScroller.ForceRedraw;
    fCurrView := toView;
    toView.GetWindow.SetTarget(toView);                 { So toView becomes target when its window
                                                         is active. }
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCardDocument.WriteCardToDisk(aCard: TCard);

    BEGIN
    IF aCard.fDirty THEN
        BEGIN
        aCard.Changed(fWorkNext);
        fWorkNext := fWorkNext + aCard.fDataSize + SIZEOF(INTEGER);
        aCard.WriteTo(fWorkRefNum);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AOpen}

PROCEDURE TCardView.IRes(itsDocument: TDocument; itsSuperView: TView; VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    INHERITED IRes(itsDocument, itsSuperView, itsParams);
    fCardDocument := TCardDocument(itsDocument);
    fCardEditCommand := NIL;
    fCurrNumber := - 1;
    fCurrCard := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AClose}

PROCEDURE TCardView.Free; OVERRIDE;

    BEGIN
    fText := DisposeIfHandle(fText);

    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

FUNCTION TCardView.DoKeyCommand(ch: Char; aKeyCode: INTEGER;
    VAR info: EventInfo): TCommand; OVERRIDE;
 { We must override this method so that we can encapsulate typing commands
   from TEView within our own commands. This is so we can make sure
   everything is set up properly before the encapsulated tries to redo or undo.
   Another approach would have been to override TTEView.DoMakeTypingCommand
   and create a descendant of TTETypingCommand which did the right things
   and then called INHERITED Undo or Redo. This has the disadvantage that
   we couldn't pass in extra parameters to ICardEditCommand.

   !!! NOTE: Future versions of MacApp will not return commands from DoKeyCommand, etc.
   Instead, they will call PostCommand to "return" the command.  So… the second
   solution is better for compatibility. }

    VAR
        aCommand:            TCommand;                    { Command returned from TEView }
        aCardEditCommand:    TCardEditCommand;            { Encapsulating command }

    BEGIN
    aCommand := INHERITED DoKeyCommand(ch, aKeyCode, info);
    IF aCommand = NIL THEN
        DoKeyCommand := aCommand
    ELSE
        BEGIN
        New(aCardEditCommand);
        FailNil(aCardEditCommand);
        aCardEditCommand.ICardEditCommand(cTyping, SELF, aCommand);
        fCardEditCommand := aCardEditCommand;
        DoKeyCommand := aCardEditCommand;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

FUNCTION TCardView.DoMenuCommand(aCmdNumber: CmdNumber): TCommand; OVERRIDE;
 { Handle our view's commands.  In the case of cut, copy, clear, and paste,
  encapsulate the command objects returned from TTEView. See the
  discussion in DoKeyCommand, above. }

    VAR
        aCommand:            TCommand;                    { Command returned from TEView }
        aCardEditCommand:    TCardEditCommand;            { Encapsulating command }
        aNewCardCommand:    TNewCardCommand;            { Command to add a card }
        aDeleteCardCommand: TDeleteCardCommand;         { Command to delete a card }

    BEGIN
    DoMenuCommand := NIL;
    CASE aCmdNumber OF
        cNextCard:
            InstallCard(fCardDocument.NextCard(fCurrNumber));
        cPrevCard:
            InstallCard(fCardDocument.PrevCard(fCurrNumber));
        cFirstCard:
            InstallCard(fCardDocument.FirstCard);
        cLastCard:
            InstallCard(fCardDocument.LastCard);
        cDeleteCard:
            BEGIN
            New(aDeleteCardCommand);
            FailNil(aDeleteCardCommand);
            aDeleteCardCommand.IDeleteCardCommand(aCmdNumber, fCardDocument, fCurrCard,
                                                  fCurrNumber);
            DoMenuCommand := aDeleteCardCommand;
            END;
        cCut, cCopy, cPaste, cClear:
            BEGIN
            aCommand := INHERITED DoMenuCommand(aCmdNumber);
            IF aCommand = NIL THEN
                DoMenuCommand := aCommand
            ELSE
                BEGIN
                New(aCardEditCommand);
                FailNil(aCardEditCommand);
                aCardEditCommand.ICardEditCommand(aCmdNumber, SELF, aCommand);
                fCardEditCommand := aCardEditCommand;
                DoMenuCommand := aCardEditCommand;
                END;
            END;
        OTHERWISE
            DoMenuCommand := INHERITED DoMenuCommand(aCmdNumber);
    END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCardView.DoSetupMenus; OVERRIDE;

    BEGIN
    INHERITED DoSetupMenus;
    IF fCurrNumber > 0 THEN
        BEGIN
        Enable(cFirstCard, TRUE);
        Enable(cLastCard, TRUE);
        Enable(cDeleteCard, TRUE);
        Enable(cPrevCard, fCardDocument.PrevCard(fCurrNumber) > 0);
        Enable(cNextCard, fCardDocument.NextCard(fCurrNumber) > 0);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TCardView.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
                                               fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TCardView', NIL, bClass);
    DoToField('fCardDocument', @fCardDocument, bObject);
    DoToField('fCurrCard', @fCurrCard, bObject);
    DoToField('fCurrNumber', @fCurrNumber, bInteger);
    DoToField('fCardEditCommand', @fCardEditCommand, bObject);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCardView.InstallCard(theCard: INTEGER);
 { Make the given card the currently displayed card in our TEView.    Update
  the currently displayed card if need be. }

    VAR
        aCard:                TCard;                        { Card we're trying to look up }
        newText:            Handle;

    BEGIN
    IF theCard = fCurrNumber THEN
        BEGIN
        {$IFC qDebug}
        WRITELN('Installing same card');
        {$ENDC}
        EXIT(InstallCard);
        END;

    IF (fCurrNumber >= 0) AND (fCurrCard <> NIL) THEN
  { Already a card showing; if any changes, update its text. The test
   for fCurrCard <> NIL should be unnecessary, but we do it just
   in case. }
        BEGIN
        DoneTyping;                                     { Tell TEView no more typing for current
                                                         command }
        UpdateCard(fCurrCard);                            { Copy text to current card }
        fCardEditCommand := NIL;                        { Cut command loose for now }
        END;

    fCurrNumber := theCard;
    fCardDocument.fCardDocData.theShownCard := theCard;

    IF theCard > 0 THEN
        BEGIN
        aCard := TCard(fCardDocument.fCards.At(theCard));
        {$IFC qDebug}
        IF aCard = NIL THEN
            BEGIN
            ProgramBreak('In TCardView.InstallCard, no card at requested index!');
            EXIT(InstallCard);
            END;
        {$ENDC}
        fCurrCard := aCard;
        fCardDocument.CacheCard(aCard);                 { Make sure data is around }

  { Ideally, if we couldn't get the text we should display something like
   "This card couldn't be read from disk", similar to MacWrite.  This
   would be easier if we were using one view; we could have a flag
   associated with the current card which set the view to display the
   message rather than the (non-existent) contents.  For this example,
   we don't bother and just display a blank card. }
        IF aCard.fData <> NIL THEN
            BEGIN
            newText := aCard.fData;
            FailOSErr(HandToHand(newText));
            END
        ELSE
            BEGIN
            newText := NewPermHandle(0);
            FailNil(newText);
            END;
        InstallText(newText);                            { make the view contain the new text }
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCardView.InstallText(newText: Handle);

    BEGIN
    StuffText(newText);
    RecalcText;
    fLastHeight := 0;                                    { force AdjustSize in SynchView }
    SetSelect(0, 0, fHTE);                                { set selection point to start of text }
    SynchView(kRedraw);
    ForceRedraw;                                        { force the view to be redrawn }
    END;

{--------------------------------------------------------------------------------------------------}
{$S AReadFile}

PROCEDURE TCardView.ShowReverted; OVERRIDE;
 { When reverting, make sure the view displays the current card at the time
  of the last save. }

    BEGIN
    fCurrNumber := - 1;
    fCurrCard := NIL;
    InstallCard(fCardDocument.fCardDocData.theShownCard);
    INHERITED ShowReverted;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCardView.UpdateCard(theCard: TCard);

    BEGIN
    theCard.newText(fText);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TEmptyView.Resize(width, height: VCoordinate; invalidate: BOOLEAN); OVERRIDE;
{ Force a redraw since the text is fit to the box }
    BEGIN
    INHERITED Resize(width, height, invalidate);
    ForceRedraw;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TEmptyView.Draw(area: Rect); OVERRIDE;
{ Just tell the good folks there's nothing to be drawn. }

    VAR
        nobodyHome:         Str255;                     { How we tell folks there's nothing there. }
        qdExtent:            Rect;

    BEGIN
    GetIndString(nobodyHome, kIDAppBuzz, bzNoCardsThere);
    GetQDExtent(qdExtent);
    SetPortTextStyle(gSystemStyle);
    MADrawString(@nobodyHome, qdExtent, teJustSystem);

    INHERITED Draw(area);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCacheableObject.ICacheableObject;

    BEGIN
    fGeneration := 0;
    fLocked := FALSE;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TCacheableObject.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
                                                      fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TCacheableObject', NIL, bClass);
    DoToField('fGeneration', @fGeneration, bInteger);
    DoToField('fLocked', @fLocked, bBoolean);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCard.ICard(itsFileLocation: LongInt; itsDocument: TCardDocument);

    BEGIN
    ICacheableObject;
    fData := NIL;
    fDataSize := 0;
    fDeleted := FALSE;
    fCardDocument := itsDocument;
    NewHome(itsFileLocation);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCard.Free; OVERRIDE;

    BEGIN
    fData := DisposeIfHandle(fData);

    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCard.Changed(itsFileLocation: LongInt);

    BEGIN
    fChanged := TRUE;
    fLocInFile := itsFileLocation;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TCard.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
    fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TCard', NIL, bClass);
    DoToField('fData', @fData, bHandle);
    DoToField('fDataSize', @fDataSize, bInteger);
    DoToField('fDirty', @fDirty, bBoolean);
    DoToField('fChanged', @fChanged, bBoolean);
    DoToField('fDeleted', @fDeleted, bBoolean);
    DoToField('fLocInFile', @fLocInFile, bLongInt);
    DoToField('fCardDocument', @fCardDocument, bObject);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCard.NewHome(itsFileLocation: LongInt);

    BEGIN
    fChanged := FALSE;
    fDirty := FALSE;
    fLocInFile := itsFileLocation;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TCard.newText(aHandle: Handle);

    BEGIN
    fDirty := TRUE;

    fData := DisposeIfHandle(fData);

    fDataSize := GetHandleSize(aHandle);
    fData := NewPermHandle(fDataSize);
    FailNil(fData);
    BlockMove(aHandle^, fData^, fDataSize);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCard.ReadFrom(aRefNum: INTEGER);

    VAR
        nChars:             LongInt;
        itsData:            Handle;

    BEGIN
    FailOSErr(SetFPos(aRefNum, fsFromStart, fLocInFile + SIZEOF(INTEGER)));

    nChars := fDataSize;                                { Set the size }

    IF fData = NIL THEN
        BEGIN
        itsData := NewPermHandle(nChars);
        fData := itsData;
        END
    ELSE
        SetHandleSize(fData, nChars);
    FailOSErr(MemError);

    FailOSErr(FSRead(aRefNum, nChars, fData^));

    fDirty := FALSE;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCard.WriteTo(aRefNum: INTEGER);

    BEGIN
    IF fDirty THEN
        BEGIN
        FailOSErr(SetFPos(aRefNum, fsFromStart, fLocInFile));
        WriteCopy(aRefNum);

        fDirty := FALSE;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCard.WriteCopy(aRefNum: INTEGER);

    VAR
        nChars:             LongInt;
        cardChars:            INTEGER;

    BEGIN
    nChars := SIZEOF(INTEGER);                            { Write the size }
    cardChars := GetHandleSize(fData);
    FailOSErr(FSWrite(aRefNum, nChars, @cardChars));

    nChars := cardChars;                                { Write the data }
    FailOSErr(FSWrite(aRefNum, nChars, fData^));
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

PROCEDURE TCardEditCommand.ICardEditCommand(itsCmdNumber: CmdNumber; itsView: TCardView;
                                            itsEncapsulatedCommand: TCommand);

    VAR
        fi:                 FailInfo;

{--------------------------------------------------------------------------------------------------}

    PROCEDURE HdlICardEditCommand(error: OSErr; message: LongInt);

        BEGIN
        Free;
        END;

    BEGIN
    fReserve := NIL;
    ICommand(itsCmdNumber, itsView.fDocument, NIL, NIL);
    fCardView := itsView;
    fEncapsulatedCommand := itsEncapsulatedCommand;
    fChangesClipboard := itsEncapsulatedCommand.fChangesClipboard;
    fCausesChange := itsEncapsulatedCommand.fCausesChange;
    fCanUndo := itsEncapsulatedCommand.fCanUndo;
    {$IFC qDebug}
    IF itsView.fCurrNumber < 0 THEN
        ProgramBreak('In TCardEditCommand.ICardEditCommand, no current card.');
    {$ENDC}
    fCardNumber := itsView.fCurrNumber;
    fCard := itsView.fCurrCard;

    CatchFailures(fi, HdlICardEditCommand);
    fReserve := NewPermHandle(kReserveSpace);
    IF fReserve = NIL THEN                                { couldn't get the space }
        BEGIN
        gApplication.CommitLastCommand;                    { free up space from previous command }
        fReserve := NewPermHandle(kReserveSpace);        { try once more }
        FailNil(fReserve);                                { if it still didn't work, give up }
        END;
    Success(fi);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TCardEditCommand.Free; OVERRIDE;

    BEGIN
    IF fCardView.fCardEditCommand = SELF THEN
        fCardView.fCardEditCommand := NIL;

    FreeIfObject(fEncapsulatedCommand);
    fEncapsulatedCommand := NIL;

    fReserve := DisposeIfHandle(fReserve);

    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TCardEditCommand.DoIt; OVERRIDE;
{ Make sure we know the card has been changed, and that it can't be purged from the cache. }

    BEGIN
    WITH fCard DO
        BEGIN
        fDirty := TRUE;
        fLocked := TRUE;
        END;
    fEncapsulatedCommand.DoIt;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TCardEditCommand.UndoIt; OVERRIDE;

    BEGIN
    IF fCardView.fCardEditCommand <> SELF THEN
        BEGIN
        fCardView.InstallCard(fCardNumber);
        fCardView.fCardEditCommand := SELF;
        END;
    fEncapsulatedCommand.UndoIt;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TCardEditCommand.RedoIt; OVERRIDE;

    BEGIN
    IF fCardView.fCardEditCommand <> SELF THEN
        BEGIN
        fCardView.InstallCard(fCardNumber);
        fCardView.fCardEditCommand := SELF;
        END;
    fEncapsulatedCommand.RedoIt;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TCardEditCommand.Commit; OVERRIDE;

    BEGIN
    fReserve := DisposeIfHandle(fReserve);

    fCard.fLocked := FALSE;
    {$IFC FALSE}
    fCardView.DoneTyping;
    {$ENDC}
    IF fCardView.fCardEditCommand = SELF THEN
        fCardView.UpdateCard(fCard);
    fEncapsulatedCommand.Commit;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TCardEditCommand.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
                                                      fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TCardEditCommand', NIL, bClass);
    DoToField('fEncapsulatedCommand', @fEncapsulatedCommand, bObject);
    DoToField('fCardView', @fCardView, bObject);
    DoToField('fCardNumber', @fCardNumber, bInteger);
    DoToField('fCard', @fCard, bObject);
    DoToField('fReserve', @fReserve, bHandle);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

PROCEDURE TNewCardCommand.INewCardCommand(itsCmdNumber: CmdNumber; itsCardDocument: TCardDocument);

    BEGIN
    ICommand(itsCmdNumber, itsCardDocument, NIL, NIL);
    fCardDocument := itsCardDocument;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TNewCardCommand.DoIt; OVERRIDE;

    BEGIN
    fCardNumber := fCardDocument.AddCard;
    WITH fCardDocument DO
        BEGIN
        fCard := TCard(fCards.At(fCardNumber));
        SELF.fSavedSelection := fCardView.fCurrNumber;
        IF fCardDocData.theCardCount <= 0 THEN
            SwapViews(fEmptyView, fCardView);
        fCardView.InstallCard(fCardNumber);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TNewCardCommand.UndoIt; OVERRIDE;

    BEGIN
    WITH fCardDocument DO
        BEGIN
        fCardView.InstallCard(fSavedSelection);
        DeleteCard(SELF.fCard);
        IF fCardDocData.theCardCount <= 0 THEN
            SwapViews(fCardView, fEmptyView);
        END;
    FreeIfObject(fCard);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TNewCardCommand.RedoIt; OVERRIDE;

    BEGIN
    DoIt;
    END;

{--------------------------------------------------------------------------------------------------}

{$S ADoCommand}

PROCEDURE TNewCardCommand.Commit; OVERRIDE;

    BEGIN
    fCard.fLocked := FALSE;                             { OK to page out now }
    fCardDocument.fCardDocData.theCardCount := fCardDocument.fCards.GetSize;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TNewCardCommand.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
                                                     fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TNewCardCommand', NIL, bClass);
    DoToField('fCardDocument', @fCardDocument, bObject);
    DoToField('fCardNumber', @fCardNumber, bInteger);
    DoToField('fCard', @fCard, bObject);
    DoToField('fSavedSelection', @fSavedSelection, bInteger);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

PROCEDURE TDeleteCardCommand.IDeleteCardCommand(itsCmdNumber: CmdNumber;
                                                itsCardDocument: TCardDocument; itsCard: TCard;
                                                itsNumber: INTEGER);

    BEGIN
    ICommand(itsCmdNumber, itsCardDocument, NIL, NIL);
    fCardDocument := itsCardDocument;
    fCard := itsCard;
    fCardNumber := itsNumber;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TDeleteCardCommand.DoIt; OVERRIDE;

    VAR
        theCardView:        TCardView;
        aCardNumber:        INTEGER;

    BEGIN
    fCard.fDeleted := TRUE;
    theCardView := fCardDocument.fCardView;
    aCardNumber := fCardDocument.NextCard(fCardNumber);
    IF aCardNumber <= 0 THEN
        aCardNumber := fCardDocument.PrevCard(fCardNumber);
    theCardView.InstallCard(aCardNumber);
    IF aCardNumber <= 0 THEN
        fCardDocument.SwapViews(theCardView, fCardDocument.fEmptyView);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TDeleteCardCommand.UndoIt; OVERRIDE;

    BEGIN
    fCard.fDeleted := FALSE;
    WITH fCardDocument DO
        BEGIN
        IF fCardDocData.theCardCount <= 1 THEN
            SwapViews(fEmptyView, fCardView);
        fCardView.InstallCard(SELF.fCardNumber);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TDeleteCardCommand.RedoIt; OVERRIDE;

    BEGIN
    DoIt;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TDeleteCardCommand.Commit; OVERRIDE;

    BEGIN
    fCardDocument.fCache.Delete(fCard);
    fCardDocument.fCards.Delete(fCard);
    FreeIfObject(fCard);
    fCardDocument.fCardDocData.theCardCount := fCardDocument.fCards.GetSize;
    IF fCardDocument.fCardDocData.theShownCard > fCardNumber THEN
        BEGIN
        WITH fCardDocument.fCardDocData DO
            theShownCard := theShownCard - 1;
        WITH fCardDocument.fCardView DO
            fCurrNumber := fCurrNumber - 1;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TDeleteCardCommand.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
                                                        fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TDeleteCardCommand', NIL, bClass);
    DoToField('fCardDocument', @fCardDocument, bObject);
    DoToField('fCardNumber', @fCardNumber, bInteger);
    DoToField('fCard', @fCard, bObject);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCardCache.ICardCache(size, growth: INTEGER);

    BEGIN
    IList;                                                { Initialize the list}
    fMaxSize := size;
    fGrowthRate := growth;
    fGeneration := 0;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCardCache.CacheCard(aCardDocument: TCardDocument; aCard: TCard);
 { Force the specified card to be in the cache, so that its data handle is
   valid.  There are a variety of conditions that can occur which makes caching
   the card difficult.    First, the cache could be full. If this is the case, we
   try to purge a card in the cache.  If no card can be purged (because they are
   locked) then we try to grow the cache (which in our implementation is always
   successful).

   If the card is already in the cache then we touch the card to tell the system
   that it had recently been accessed.    If it must be added to the cache, we read
   its contents from the disk and insert the card }

    LABEL 1000;

    VAR
        victimCard:         TCard;                        { Card to be paged out }
        fi:                 FailInfo;

{--------------------------------------------------------------------------------------------------}

    PROCEDURE HdlCacheFailed(error: OSErr; message: LongInt);

        BEGIN
        GOTO 1000;                                        { Pretend nothing happened }
        END;

    BEGIN
    CatchFailures(fi, HdlCacheFailed);
    IF CardIsInCache(aCard) THEN                        { already in memory }
    { Touch card as being recently accessed }
        Touch(aCard)
    ELSE                                                { not in memory }
        BEGIN
        WHILE fSize >= fMaxSize DO
            BEGIN
            victimCard := PurgeableCard(aCardDocument);
            IF victimCard = NIL THEN
                Grow                                    { Grow the Cache if we can - Error if we
                                                         can't }
            ELSE
                Delete(victimCard)                        { victim goes out }
            END;
  { ELSE cache not yet filled, so can blithely add it to the cache without
   first deleting something }
        aCard.fCardDocument.ReadCardFromDisk(aCard);
        Insert(aCard);
        END;
    Success(fi);
1000: ;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

FUNCTION TCardCache.CardIsInCache(aCard: TCard): BOOLEAN;
{ Checks to see if aCard is already in the Cache}

{--------------------------------------------------------------------------------------------------}

    FUNCTION LookInCache(athing: TObject): BOOLEAN;

        BEGIN
        LookInCache := (TCard(athing) = aCard);
        END;

    BEGIN
    CardIsInCache := FirstThat(LookInCache) <> NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCardCache.Delete(item: TObject); OVERRIDE;
{ Deletes a card from the cache by flushing the card to disk and disposing of the
  handle to the card.  Set its data pointer to NIL to tell the system that it is
  no longer in memory}

    VAR
        aCard:                TCard;

    BEGIN
    aCard := TCard(item);
    aCard.fCardDocument.WriteCardToDisk(aCard);
    INHERITED Delete(aCard);
    DisposHandle(aCard.fData);
    aCard.fData := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TCardCache.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
                                                fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TCardCache', NIL, bClass);
    DoToField('fMaxSize', @fMaxSize, bInteger);
    DoToField('fGrowthRate', @fGrowthRate, bInteger);
    DoToField('fGeneration', @fGeneration, bInteger);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S AClose}

PROCEDURE TCardCache.FreeDocCards(aCardDocument: TCardDocument);
{ Free all of the cards in the cache which belong to a document.}

{--------------------------------------------------------------------------------------------------}

    PROCEDURE MaybeDelete(item: TObject);

        BEGIN
        IF TCard(item).fCardDocument = aCardDocument THEN
            Delete(TCard(item));
        END;

    BEGIN
    Each(MaybeDelete);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ANonRes}

PROCEDURE TCardCache.Grow;
{ Grow the cache by the cache growth rate }

    BEGIN
    fMaxSize := fMaxSize + fGrowthRate;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCardCache.Insert(item: TObject);
{ Insert a card in the cache and bump the generation count of the cache.  Attach
  this generation count to the card to let the purger no that this card has been recently
  accessed. }

    BEGIN
    Touch(TCard(item));
    INHERITED Insert(item);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCardCache.Touch(aCard: TCard);
{ Bump the generation count }

    BEGIN
    fGeneration := fGeneration + 1;
    aCard.fGeneration := fGeneration;                    { Update generation of the card }
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

FUNCTION TCardCache.PurgeableCard(aCardDocument: TCardDocument): TCard;
{ Determine which card to purge from the cache.  This is rather simplistic algorithm.  Find
  the oldest card that is not locked and does not belong to the currently active document.
  If all the cards belong to the currently active document then return the oldest of those.
  Finally, if all the cards are locked, return NIL.}

    VAR
        oldestInDoc:        TCard;
        oldestNotInDoc:     TCard;
        i:                    INTEGER;
        aCard:                TCard;

    BEGIN
    oldestInDoc := NIL;
    oldestNotInDoc := NIL;
    FOR i := 1 TO fSize DO
        BEGIN
        aCard := TCard(At(i));
        IF NOT aCard.fLocked THEN
            IF (aCard.fCardDocument = aCardDocument) THEN
                BEGIN
                IF (oldestInDoc <> NIL) THEN
                    BEGIN
                    IF aCard.fGeneration < oldestInDoc.fGeneration THEN
                        oldestInDoc := aCard;
                    END
                ELSE
                    oldestInDoc := aCard;
                END
            ELSE
                BEGIN
                IF (oldestNotInDoc <> NIL) THEN
                    BEGIN
                    IF aCard.fGeneration < oldestNotInDoc.fGeneration THEN
                        oldestNotInDoc := aCard;
                    END
                ELSE
                    oldestNotInDoc := aCard;
                END;
        END;
    IF oldestNotInDoc <> NIL THEN
        PurgeableCard := oldestNotInDoc
    ELSE
        PurgeableCard := oldestInDoc;
    END;